perm filename M11C.F4[M11,LCS]1 blob
sn#373992 filedate 1978-08-02 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C00016 ENDMK
Cā;
CFORS3 FORTRAN UNIT GENERATOR ROUTINE
C *** MUSIC V ***
SUBROUTINE FORSAM
REAL IN1,IN2,IN3,IN4
DIMENSION L(10),M(10)
C CAN USE UP TO 10 FIELDS IN UNIT GEN.
COMMON I(1) /P/P(1) /GENS/GENS(1) /IRAN/IRAN /LFUNC/LFUNC
COMMON /INS/INS(1) /NT/RNT(1) /ROUT/ROUT(1)
C INS=INSTRUMENT DEFINITIONS, RNT=NOTE CARD INFO, ROUT=OUTPUT BLOCK
EQUIVALENCE(M1,M(1)),(M2,M(2)),(M3,M(3)),(M4,M(4)),(M5,M(5)),(M6,M
1(6)),(M7,M(7)),(M8,M(8)),(L1,L(1)),(L2,L(2)),(L3,L(3)),(L4,L(4)),(
2L5,L(5)),(L6,L(6)),(L7,L(7)),(L8,L(8))
XNFUN=LFUNC-1
C COMMON INITIALIZATION OF GENERATORS
N1=I(6)+2
N2=INS(N1-1)-1
DO 204 J1=N1,N2
J2=J1-N1+1
IF(INS(J1).GE.0)GO TO 201
200 L(J2)=-INS(J1)
M(J2)=1
GO TO 204
201 M(J2)=0
IF(INS(J1)-26262.GT.0)GO TO 203
C***** WHAT DOES THE BIG NUMBER DO?????
C*** IT SEEMS TO BE JUST TO MAKE A FLAG. NOW CHANGED TO FIT INTO 16BITS.
202 L(J2)=INS(J1)+I(3)-1
GO TO 204
203 L(J2)=I(J1)-26262
C****** WHAT DOES THIS BIG NUM. DO?? ***********
204 CONTINUE
NSAM=I(5)
NSAMX=NSAM-1
N3=INS(N1-2)
NGEN= N3 -100
GO TO (101,102,103,104,105,106,107,108,109,110,111,112),NGEN
IF(NGEN.EQ.14)CALL OPT(L,M,NSAM)
C FOLLOWING IS SUGGESTED HEADER FOR SUBROUTINE OPT
C SUBROUTINE OPT(L,M,NSAM)
C DIMENSION L(8),M(8)
C COMMON /GENS/GENS(1)/IRAN/IRAN/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
112 RETURN
C UNIT GENERATORS
C OUTPUT BOX
CX 101 IF(M1.LE.0)IN1=RNT(L1)
CX DO 270 J3=0,NSAM-1
CX IF(M1.GT.0)IN1=ROUT(J3+L1)
CX 265 J5=L2+J3
CX ROUT(J5)=IN1+ROUT(J5)
CX 270 CONTINUE
CX RETURN
101 DO 270 K=0,NSAMX
J5=L2+K
270 ROUT(J5)=ROUT(J5)+ROUT(K+L1)
RETURN
C OUTPUT=WHAT'S THERE ALREADY + WHAT'S COMING IN FROM THIS INST.
C THIS NEW FORM ASSUMES THE OUT BOX HAS ONLY 'Bn' AS INPUT.
C OSCILLATOR L1,L2 = P or B L3=B L4=F L5=P
C M1, M2 =1 = NT. =0 = ROUT (P=FIXED INPUT, B=DYNAMIC INPUT, F=FUNC.)
102 SUM=RNT(L5)
IF(M1.LE.0)AMP=RNT(L1)
IF(M2.LE.0)FREQ=RNT(L2)
DO 293 J3=0,NSAMX
J4=INT(SUM)+L4
F=GENS(J4)
C GENS(J4) IS IN FUNC STORAGE AREA.
IF(M2.GT.0)GO TO 286
SUM=SUM+FREQ
GO TO 290
286 J4=L2+J3
SUM=SUM+ROUT(J4)
290 IF(SUM.GE.XNFUN)GO TO 287
IF(SUM.LT.0.0)GO TO 289
288 J5=L3+J3
IF(M1.GT.0)GO TO 292
ROUT(J5)=AMP*F
GO TO 293
C**********
287 SUM=SUM-XNFUN
GO TO 288
289 SUM=SUM+XNFUN
GO TO 288
C******* ABOVE FOR FM (NEG. FREQ. TO OSCIL)
292 J6=L1+J3
ROUT(J5)=ROUT(J6)*F
293 CONTINUE
RNT(L5)=SUM
C L5 POINTS TO NOTE ARRAY. SAVE A POINTER.
RETURN
C ADD TWO BOX
C LOOK AT NT ARRAY FOR FIXED VALUES, LOOK AT ROUT FOR CHANGING VALS.
103 IF(M1.LE.0)IN1=RNT(L1)
IF(M2.LE.0)IN2=RNT(L2)
DO 258 J3=0,NSAMX
IF(M1.GT.0)IN1=ROUT(J3+L1)
IF(M2.GT.0)IN2=ROUT(L2+J3)
ROUT(J3+L3)=IN1+IN2
258 CONTINUE
RETURN
C RANDOM INTERPOLATING GENERATOR RAI Px Py Bn Pq Pr Ps; OR RAI L1 L2 L3 L4 L5 L6;
C M1=0=Pn M1=1=Bn
104 SUM=RNT(L4)
IF(M1.LE.0)XIN1=RNT(L1)
IF(M2.LE.0)XIN2=RNT(L2)
313 RN1=RNT(L5)
RN3=RNT(L6)
DO 340 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
IF(SUM-XNFUN.LT.0)GO TO 320
SUM=SUM-XNFUN
IRAN=IABS (IRAN*IMULT)
RN4=(2.*FLOAT(IRAN)-1.)
RN2=RN4-RN3
RN1=RN3
RN3=RN4
GO TO 321
320 RN2=RN3-RN1
321 ROUT(J3+L3)=XIN1*(RN1+(RN2*SUM)/XNFUN)
SUM=SUM+XIN2
340 CONTINUE
RNT(L4)=SUM
RNT(L5)=RN1
RNT(L6)=RN3
RETURN
C ENVELOPE GENERATOR ENV PorB, F, B, P, P, P, P;
C AMP FUN OUT AT ST DC STO
105 SUM=RNT(L7)
XIN4=RNT(L4)
XIN5=RNT(L5)
XIN6=RNT(L6)
XIN5=1./(1./XIN5 - 1./XIN4 -1./XIN6 )
C XIN5 HAS INCR. VALUE OF STEADY STATE. (IT WAS TOTAL DUR. BEFORE.)
C THESE 3 PARAMS ARE ATTACK DUR, TOTAL DUR, DECAY DUR.
C STEADY STATE TIME IS COMPUTED
IF(M1.LE.0)AMP =RNT(L1)
CX IF(M4.LE.0)XIN4=FLOAT(RNT(L4))*SFI
CX IF(M5.LE.0)XIN5=FLOAT(RNT(L5))*SFI
CX IF(M6.LE.0)XIN6=FLOAT(RNT(L6))*SFI
XIN4=XIN4/4.
XIN5=XIN5/4.
XIN6=XIN6/4.
387 X1=XNFUN/4.
X2=2.*X1
X3=3.*X1
DO 403 J3=0,NSAMX
J4=INT(SUM)+L2
F=GENS(J4)
IF(M1.GT.0)AMP =ROUT(J3+L1)
IF(SUM-XNFUN.GE.0)SUM=SUM-XNFUN
IF(SUM-X1.GT.0)GO TO 393
CX IF(M4.GT.0)XIN4=FLOAT(ROUT(J3+L4))
SUM=SUM+XIN4
GO TO 402
393 IF(SUM-X2.GT.0)GO TO 397
CX IF(M5.GT.0)XIN5=FLOAT(ROUT(J3+L5))
SUM=SUM+XIN5
GO TO 402
CX397 IF(M6.GT.0)XIN6=FLOAT(ROUT(J3+L6))
397 SUM=SUM+XIN6
402 J7=L3+J3
ROUT(J7)=AMP*F
403 CONTINUE
RNT(L7)=SUM
RETURN
C STEREO OUTPUT BOX L1,L2 = B L3=B1
C IT IS ASSUMED ALL INPUTS ARE 'B' TYPE.
106 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
ICT=0
DO 510 J3=1,NSSAM,2
J4=L1+ICT
IN1=ROUT(J4)
505 J5=L3+J3-1
ROUT(J5)=IN1+ROUT(J5)
506 J4=L2+ICT
IN2=ROUT(J4)
507 J5=L3+J3
ROUT(J5)=IN2+ROUT(J5)
510 ICT=ICT+1
RETURN
C STEREO OUTPUT BOX
CX106 IF(M1.GT.0)GO TO 501
CCC 106 IF(M1)500,500,501
CX 500 IN1=I(L1)
CX501 IF(M2.GT.0)GO TO 503
CCC 501 IF(M2)502,502,503
CX 502 IN2=I(L2)
CX 503 NSSAM=2*NSAM
C 6/29/70 L.C.SMITH
CX ICT=0
CX DO 510 J3=1,NSSAM,2
CX IF(M1.LE.0)GO TO 505
CCC IF(M1)505,505,504
CC*** 504 J4=L1+J3-1
CX504 J4=L1+ICT
CX IN1=I(J4)
CX 505 J5=L3+J3-1
CX I(J5)=IN1+I(J5)
CX IF(M2.LE.0)GO TO 507
CCC IF(M2)507,507,506
CC*** 506 J4=L2+J3-1
CX506 J4=L2+ICT
CX IN2=I(J4)
CX 507 J5=L3+J3
CX I(J5)=IN2+I(J5)
CX 510 ICT=ICT+1
CX RETURN
C ADD 3 BOX
107 IF(M1.LE.0)IN1=RNT(L1)
IF(M2.LE.0)IN2=RNT(L2)
IF(M3.LE.0)IN3=RNT(L3)
DO 780 J3=0,NSAMX
IF(M1.GT.0)IN1=ROUT(L1+J3)
IF(M2.GT.0)IN2=ROUT(L2+J3)
IF(M3.GT.0)IN3=ROUT(L3+J3)
ROUT(J3+L4)=IN1+IN2+IN3
780 CONTINUE
RETURN
C ADD 4 BOX
108 IF(M1.LE.0)IN1=RNT(L1)
IF(M2.LE.0)IN2=RNT(L2)
IF(M3.LE.0)IN3=RNT(L3)
IF(M4.LE.0)IN4=RNT(L4)
DO 880 K=0,NSAMX
IF(M1.GT.0)IN1=ROUT(L1+K)
859 IF(M2.GT.0)IN2=ROUT(L2+K)
IF(M3.GT.0)IN3=ROUT(L3+K)
863 IF(M4.GT.0)IN4=ROUT(L4+K)
ROUT(L5+K)=IN1+IN2+IN3+IN4
880 CONTINUE
RETURN
C MULTIPLIER
109 IF(M1.LE.0)XIN1=RNT(L1)
IF(M2.LE.0)XIN2=RNT(L2)
DO 908 J3=0,NSAMX
IF(M1.GT.0)XIN1=ROUT(J3+L1)
IF(M2.GT.0)XIN2=ROUT(J3+L2)
ROUT(J3+L3)=XIN1*XIN2
908 CONTINUE
RETURN
C SET NEW FUNCTION IN OSC OR ENV
110 ILOC=N1+6
IF(INS(N1+1).EQ.105) ILOC=N1+4
JN1=I(3)+INS(N1)-1
IIN1=RNT(JN1)
IF(IIN1)960,960,955
955 INS(ILOC)=-(IIN1-1)*LFUNC-1
960 RETURN
C RANDOM AND HOLD GENERATOR RAH Px Py Bn Pq Pr; OR RAH L1 L2 L3 L4 L5;
C M1=0=Pn M1=1=Bn
111 SUM=ROUT(L4)
IF(M1.LE.0)XIN1=RNT(L1)
IF(M2.LE.0)XIN2=RNT(L2)
913 RN=RNT(L5)
DO 940 J3=0,NSAMX
IF(M1.GT.0) XIN1=ROUT(J3+L1)
IF(M2.GT.0) XIN2=ROUT(J3+L2)
IF(SUM-XNFUN.LT.0)GO TO 920
SUM=SUM-XNFUN
IRAN=IABS (IRAN*IMULT)
RN=(2.*FLOAT(IRAN)-1.)
920 ROUT(J3+L3)=XIN1*RN
SUM=SUM+XIN2
940 CONTINUE
RNT(L4)=SUM
RNT(L5)=RN
RETURN
END
SUBROUTINE OPT(L,M,NSAM)
DIMENSION L(1),M(1)
COMMON /GENS/GENS(1)/IRAN/IRAN/LFUNC/LFUNC/NT/RNT(1)/ROUT/ROUT(1)
C THIS IS A DUMMY ROUTINE OPT Pm Pn Bn; doubles value of Bn
J1=L(3)
C L(3) MEANS LOOK AT 3RD FIELD OF 'OPT'
J2=J1+NSAM-1
DO 1 K=J1,J2
1 ROUT(K)=ROUT(K)*2
RETURN
END